unit sci.term;

(* A diffrent way for solving equations: divide expression into terms. *)
interface
uses
  Windows, variants, Sysutils, Classes,
  sci.log, sci.types, sci.sort;

const
  MAX_UNKNOWN = 52;  (* 'A' - 'Z' and 'a' - 'z' *)
  MAX_TERM = 1000;

type
  TSymbol = (PLUS, MINUS, TIMES, DIVIDE, CARET, LPAREN, RPAREN, COMMA,
          //   +     -      *      /       ^      (         )      ,
              EQL, NEQ, LSS, GTR, LEQ, GEQ,
          //   =    <>   <    >    <=   >=
              NUMBER, IDENT,
              ENDEXPR, ERROR);

  TUnknown = record
    unk: char;
    exp: TValue;
  end;
  TUnknownList = array [0..MAX_UNKNOWN] of TUnknown;

  TTerm = class
  public
    coefficient: TValue;
    unk: TUnknownList;
    unc: integer;
    exp: TValue;

    constructor Create;
    procedure Assign(rhs: TTerm);
    procedure AddUnk(unk: char); overload;
    procedure AddUnk(unk: TUnknown); overload;
    procedure Merge(rhs: TTerm);
    procedure TimesBy(rhs: TTerm);
    procedure DivideBy(rhs: TTerm);
    procedure Expand;
    function ContainsUnk: boolean;
    function TermAsStr: string;
    function UnkAsStr: string;
    procedure Print;
  end;

  TTermList = class
  public
    terms: array [1..MAX_TERM] of TTerm;
    cnt: integer;
    constructor Create; overload;
    constructor Create(expr: string); overload;
    procedure Assign(rhs: TTermList);
    procedure ReverseSign;
    procedure TimesBy(const rhs: TTermList); overload;
    procedure TimesBy(rhs: TTerm); overload;
    procedure Insert(t: TTerm);
    procedure Remove(t: TTerm);
    function Format: string;
    function CountUnk: integer;
    function HighestExp: integer;
    procedure Print;
  end;

  TTermParser = class
  private
    expr: TStream;
    lastNumber: real;
    lastWord: string;
    lastChar: char;
    lastSym: TSymbol;
    function getChar: char;
    procedure match(expected: TSymbol);
    function expression: TTermList;
    function term: TTermList;
    function factor: TTermList;
  public
    procedure setStrExpression(expr: string);
    function getSymbol: TSymbol;
    function parse: TTermList;
  end;

implementation

uses
  sci.simplifier;

constructor TTerm.Create;
begin
  Self.coefficient := 0;
  Self.exp := 1;
  Self.unc := 0;
end;

procedure TTerm.Assign(rhs: TTerm);
var
  i: integer;
begin
  Self.coefficient := rhs.coefficient;
  Self.unc := rhs.unc;
  Self.exp := rhs.exp;
  for i := 1 to Self.unc do
    Self.unk[i] := rhs.unk[i];
end;

procedure TTerm.AddUnk(unk: char);
var
  i: integer;
begin
  if Self.coefficient = 0 then inc(Self.coefficient);
  for i := 1 to Self.unc do
  begin
    if Self.unk[i].unk = unk then
    begin
      inc(Self.unk[i].exp);
      exit;
    end;
  end;

  inc(unc);
  Self.unk[unc].unk := unk;
  Self.unk[unc].exp := 1;
end;

procedure TTerm.AddUnk(unk: TUnknown);
var
  i: integer;
begin
  if Self.coefficient = 0 then inc(Self.coefficient);
  for i := 1 to Self.unc do
  begin
    if Self.unk[i].unk = unk.unk then
    begin
      Self.unk[i].exp := Self.unk[i].exp + unk.exp;
      exit;
    end;
  end;

  inc(unc);
  Self.unk[unc] := unk;
end;

procedure TTerm.Merge(rhs: TTerm);
begin
  if Self.TermAsStr <> rhs.TermAsStr then raise Exception.Create('Cannot merge.');

  Self.coefficient := Self.coefficient + rhs.coefficient;
end;

procedure TTerm.TimesBy(rhs: TTerm);
var
  i: integer;
begin
  if Self.UnkAsStr = rhs.UnkAsStr then
  begin
    inc(Self.exp, rhs.exp);
    exit;
  end;
  Self.Expand; rhs.Expand;
  Self.coefficient := Self.coefficient * rhs.coefficient;
  for i := 1 to rhs.unc do
    Self.AddUnk(rhs.unk[i]);
end;

procedure TTerm.DivideBy(rhs: TTerm);
begin

end;

procedure TTerm.Expand;
var
  i: integer;
begin
  for i := 1 to unc do
  begin
    Self.unk[i].exp := Self.unk[i].exp * Self.exp;
  end;
  Self.exp := 1;
end;

function TTerm.ContainsUnk: boolean;
begin
  Result := Self.unc <> 0;
end;

function TTerm.TermAsStr: string;
var
  sorter: TSorter<TUnknown>;
  i: integer;
begin
  sorter := TSorter<TUnknown>.Create;
  sorter.QSort(unk, 0, unc);
  Result := '(';
  for i := 1 to unc do
  begin
    Result := Result + unk[i].unk + IntToStr(unk[i].exp); (* XXX: Shouldn't use inttostr here,
                                                           *)
  end;
  Result := Result + ')' + IntToStr(Self.exp);
end;

function TTerm.UnkAsStr: string;
var
  sorter: TSorter<TUnknown>;
  i: integer;
begin
  sorter := TSorter<TUnknown>.Create;
  sorter.QSort(unk, 0, unc);
  Result := '';
  for i := 1 to unc do
  begin
    Result := Result + unk[i].unk + IntToStr(unk[i].exp); (* XXX: Shouldn't use inttostr here,
                                                           *)
  end;
end;

procedure TTerm.Print;
var
  i: integer;
begin
  dbgprintln('Coefficient: ' + IntToStr(Self.coefficient));
  dbgprintln('Unknowns: ');
  for i := 1 to Self.unc do
  begin
    dbgprintln(Self.unk[i].unk + ', exponent: ' + IntToStr(Self.unk[i].exp));
  end;
  dbgprintln('Exponent: ' + IntToStr(Self.exp));
end;

constructor TTermList.Create;
begin
  fillchar(terms, sizeof(terms), 0);
  cnt := 0;
end;

constructor TTermList.Create(expr: string);
var
  p: TTermParser;
begin
  p := TTermParser.Create;
  p.setStrExpression(expr);
  Self := p.parse;
end;

procedure TTermList.Assign(rhs: TTermList);
var
  i: integer;
begin
  Self.cnt := rhs.cnt;
  for i := 1 to Self.cnt do
  begin
    Self.terms[i] := TTerm.Create;
    Self.terms[i].Assign(rhs.terms[i]);
  end;
end;

procedure TTermList.ReverseSign;
var
  i: integer;
begin
  for i := 1 to Self.cnt do
    Self.terms[i].coefficient := - Self.terms[i].coefficient;
end;

procedure TTermList.TimesBy(const rhs: TTermList);
var
  tl1, tl2: TTermList;
  i, j: integer;
begin
  tl1 := TTermList.Create;
  for i := 1 to Self.cnt do
  begin
    tl2 := TTermList.Create;
    tl2.Assign(rhs);
    tl2.TimesBy(Self.terms[i]);
    for j := 1 to tl2.cnt do
    begin
      inc(tl1.cnt);
      tl1.terms[tl1.cnt] := tl2.terms[j];
    end;
  end;
  Self.Assign(tl1);
end;

procedure TTermList.TimesBy(rhs: TTerm);
var
  i: integer;
begin
  for i := 1 to Self.cnt do
    Self.terms[i].TimesBy(rhs);
end;

function TTermList.Format: string;
var
  i: integer;
  j: integer;
  tmp: TTerm;
begin
  tmp := TTerm.Create;
  Result := '';
  for i := 1 to Self.cnt do
  begin
    tmp.Assign(Self.terms[i]);
    if tmp.coefficient = 0 then continue;
    if (tmp.coefficient > 0) and (i <> 1) then Result := Result + '+';
    if (tmp.coefficient <> 1) then Result := Result + IntToStr(tmp.coefficient);
    if tmp.exp <> 1 then Result := Result + '(';
    for j := 1 to tmp.unc do
    begin
      Result := Result + tmp.unk[j].unk;
      if tmp.unk[j].exp <> 1 then Result := Result + '^' + IntToStr(tmp.unk[j].exp);
    end;
    if tmp.exp <> 1 then Result := Result + ')^' +  IntToStr(tmp.exp);
  end;
end;

procedure TTermList.Insert(t: TTerm);
begin
  inc(cnt);
  Self.terms[cnt] := TTerm.Create;
  Self.terms[cnt].Assign(t);
end;

procedure TTermList.Remove(t: TTerm);
var
  i: integer;
  idx: integer;
begin
  idx := -1;
  for i := 1 to cnt do
    if terms[i] = t then
    begin
      idx := i;
      break;
    end;
  if idx = -1 then raise Exception.Create('No such term.');

  for i := idx to cnt - 1 do
    terms[i].Assign(terms[i + 1]);

  dec(cnt);
end;

function TTermList.CountUnk: integer;
var
  s: TSysCharset;
  i, j: integer;
begin
  s := [];
  Result := 0;
  for i := 1 to Self.cnt do
  begin
    for j := 1 to Self.terms[i].unc do
    begin
       if not CharInSet(Self.terms[i].unk[i].unk, s) then
       begin
         inc(Result);
         s := s +  [Self.terms[i].unk[i].unk];
       end;
    end;
  end;
end;

function TTermList.HighestExp: integer;
var
  i: integer;
begin
  Result := - maxint;
  for i := 1 to Self.cnt do
    if Self.terms[i].exp > Result then Result := Self.terms[i].exp; 
end;

procedure TTermList.Print;
var
  i: integer;
begin
  dbgprintln('--------------TTERMLIST-------------------');
  for i := 1 to Self.cnt do
  begin
    dbgprintln('Term ' + IntToStr(i));
    Self.terms[i].Print;
  end;
  dbgprintln('--------------TTERMLIST-------------------');
end;

function isLetter(c: char): boolean;
begin
  Result := ((c >= 'A') and (c <= 'Z')) or ((c >= 'a') and (c <= 'z'));
end;

function isDigit(c: char): boolean;
begin
  Result := ((c >= '0') and (c <= '9')) or (c = '.');
end;

function isAlnum(c: char): boolean;
begin
  Result := isLetter(c) or isDigit(c);
end;

function symName(sym: TSymbol): string;
begin
  case sym of
    PLUS: Result := '+';
    MINUS: Result := '-';
    TIMES: Result := '*';
    DIVIDE: Result := '/';
    LPAREN: Result := '(';
    RPAREN: Result := ')';
    NUMBER: Result := 'NUMBER';
    IDENT: Result := 'IDENT';
    EQL: Result := '=';
    NEQ: Result := '<>';
    LSS: Result := '<';
    GTR: Result := '>';
    LEQ: Result := '<=';
    GEQ: Result := '>=';
    ENDEXPR: Result := 'END';
  end;
end;

function TTermParser.getChar;
var
  b: byte;
begin
  if expr.Position = expr.Size then
  begin
    result := char(-1);
    exit;
  end;
  expr.Read(b, 1);
  result := chr(b);
end;

procedure TTermParser.match(expected: TSymbol);
begin
  if Self.lastSym = expected then lastSym := getSymbol
  else raise Exception.Create('Unexpected symbol.');
end;

procedure TTermParser.setStrExpression(expr: string);
begin
  Self.expr := TStringStream.Create(TSimplifier.Format(expr));
  lastChar := getChar;
  lastSym := getSymbol;
end;

function TTermParser.getSymbol: TSymbol;
begin
  lastWord := '';
  Result := ERROR;
  if lastChar = char(-1) then exit(ENDEXPR);
  while ((lastChar = ' ')) do
    lastChar := getChar;                           // skip space and tab
  if isLetter(lastChar) then
  begin
    repeat
      lastWord := lastWord + lastChar;
      lastChar := getChar;
    until not isAlnum(lastChar);
    exit(IDENT);
  end
  else if isDigit(lastChar) then // number
  begin
    repeat
      lastWord := lastWord + lastChar;
      lastChar := getChar;
    until not isDigit(lastChar);
    lastNumber := strToFloat(lastWord);
    exit(NUMBER);
  end
  else if lastChar = '<' then
  begin
    lastChar := getChar;
    if lastChar = '=' then exit(LEQ)
    else if lastChar = '>' then exit(NEQ)
    else exit(LSS);
  end
  else if lastChar = '>' then
  begin
    lastChar := getChar;
    if lastChar = '=' then exit(GEQ)
    else exit(GTR);
  end
  else if lastChar = '+' then Result := PLUS
  else if lastChar = '-' then Result := MINUS
  else if lastChar = '*' then Result := TIMES
  else if lastChar = '/' then Result := DIVIDE
  else if lastChar = '^' then Result := CARET
  else if lastChar = '(' then Result := LPAREN
  else if lastChar = ')' then Result := RPAREN
  else if lastChar = '=' then Result := EQL
  else if lastChar = ',' then Result := COMMA;
  lastChar := getChar;
end;

function TTermParser.expression: TTermList;
var
  tl, tl1: TTermList;
  i: integer;
  sym: TSymbol;
begin
  tl := term();
  while ((lastSym = PLUS) or (lastSym = MINUS)) do
  begin
    sym := lastSym;
    match(lastSym);
    tl1 := term;
    if sym = MINUS then tl1.ReverseSign;
    for i := 1 to tl1.cnt do
    begin
      inc(tl.cnt);
      tl.terms[tl.cnt] := tl1.terms[i];    (* Append to tl *)
    end;
  end;
  Result := tl;
end;

function TTermParser.term: TTermList;
var
  tl: TTermList;
  sym: TSymbol;
begin
  tl := factor();
  while ((lastSym = TIMES) or (lastSym = DIVIDE)) do
  begin
    sym := lastSym;
    match(lastSym);
    if sym = TIMES then tl.TimesBy(factor);
  end;
  Result := tl;
end;

function TTermParser.factor: TTermList;
begin
  case lastSym of
    LPAREN:
    begin
      match(LPAREN);
      Result := expression;
      match(RPAREN);
    end;
    MINUS:  // Negative number
    begin
      match(MINUS);
      Result := factor;
      Result.ReverseSign;
    end;
    NUMBER:
    begin
      Result := TTermList.Create;
      Result.cnt := 1;
      Result.terms[1] := TTerm.Create;
      Result.terms[1].coefficient := lastNumber;
      match(NUMBER);
    end;
    IDENT:
    begin
      Result := TTermList.Create;
      Result.cnt := 1;
      Result.terms[1] := TTerm.Create;
      Result.terms[1].AddUnk(lastWord[1]);
      match(IDENT);
    end;
    else
      raise Exception.Create('Unexpected symbol.');
  end;
end;

function TTermParser.parse: TTermList;
begin
  Result := expression;
end;


end.
